home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / sys / mipskernel.t < prev    next >
Text File  |  1989-06-30  |  16KB  |  409 lines
  1. (herald mipskernel (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;; The procedure big_bang MUST come first in this file.
  27. ;;; BIG_BANG is called to instantiate the root process of an external
  28. ;;; T image. It is called by a foreign stub program with arguments
  29. ;;; as follows:
  30. ;;;
  31. ;;;  (BIG_BANG memory mem-size argc argv bsd4.2?).
  32. ;;;
  33. ;;; The argument vector is saved as a T vector in *BOOT-ARGS*.  The
  34. ;;; Xenoids are created for STDIN and STDOUT and placed in the 2nd
  35. ;;; and 3rd argument registers.  The global-constant register (NIL)
  36. ;;; and the task register are initialized, and the root process
  37. ;;; block is created and initialized.  The stack is initialized.
  38. ;;; The heap-pointer and heap-limit of the root process are
  39. ;;; initialized.  Finally the address of the T procedure BOOT is
  40. ;;; placed in them P (procedure) register, and we jump through the
  41. ;;; root process block to ICALL.  Boot is called as follows:
  42. ;;;
  43. ;;;     (BOOT root-task boot-args),
  44.  
  45. ;;; Unresolved issues:
  46. ;;; - Is the arg vector the right size and is the descriptor correct?
  47. ;;; - What should the initial stack size be and how can you tell?
  48. ;;; - The stack and areas should have guards - later I  guess
  49. ;;; - how to boot other systems
  50. ;;; - stdio shit?
  51. ;;; - PID as Fixnum?
  52. ;;; - *the-slink*
  53. ;;; - test stack-overflow in icall?
  54. ;;; - heap overflow code
  55. ;;; - exception code
  56. ;;; - interrupt code
  57.  
  58.  
  59. ;;;  When we enter Big_bang the stack looks as follows:
  60. ;;;
  61. ;;;              |      debug?   |
  62. ;;;              |_______________|
  63. ;;;              |      argv     |    Command line argv
  64. ;;;              |_______________|
  65. ;;;              |      argc     |    Command line argc
  66. ;;;              |_______________|
  67. ;;;              |  heap-size    |  
  68. ;;;              |_______________|
  69. ;;;              |     heap2     | 
  70. ;;;              |_______________|  
  71. ;;;              |     heap1     |
  72. ;;;              |_______________|
  73. ;;;       SP =>  |     dummy     |
  74. ;;;              |_______________|
  75. ;;;              |    header     |  <= *boot-args*
  76. ;;;              |_______________|
  77.  
  78. (define (big_bang)
  79.   (lap (*boot* *the-slink* risc-big-bang)
  80.  
  81.     ;; set up global-constants
  82.     (move zero crit-reg)
  83.     (move ($ header/true) t-reg)
  84.     (load l (d@r P (static *the-slink*)) extra)
  85.     (load l (d@r extra 2) nil-reg)
  86.     (sub ($ 3) nil-reg sp)        ;grows down to data bottom 512K
  87.     (sll ($ 2) scratch)
  88.     (store l scratch (d@nil slink/interrupt-handler))    ; interrupt_xenoid
  89.  
  90.     (store l a2 (d@r ssp 0))        ;heap1  a2=$4
  91.     (store l a3 (d@r ssp 4))        ;heap2
  92.     (store l a4 (d@r ssp 8))        ;heap-size
  93.     (store l a5 (d@r ssp 12))        ;argc
  94.     (move SSP A1)  ; save argument pointer        
  95.     (sub ($ 8) ssp)            ;dummy,header
  96.     (movec (fx+ (fixnum-ashl 6 8) header/general-vector) extra)
  97.     (store l extra (d@r ssp 0))
  98.     (add ($ 2) ssp a2)
  99.     (store l A2 (d@nil slink/boot-args))    ; we have 6 boot-args
  100.  
  101.     (load l (d@r P (static risc-big-bang)) P)
  102.     (load l (d@r p 2) p)
  103.     (load l (d@r P -2) extra)
  104.     (add ($ 2) extra)
  105.     (jalr extra)
  106.     (noop)
  107.     ;; initialize area, area-frontier, and area-limit
  108.     (load l  (d@r A1 0) scratch)                       ; move addr heap
  109.     (store l scratch (d@nil slink/area-begin))      
  110.     (store l scratch (d@nil slink/area-frontier))         
  111.     (load l (d@r A1 8) vector)
  112.     (add vector scratch)
  113.     (store l scratch (d@nil slink/area-limit))
  114.  
  115.     ;; Set up the procedure register P and call boot,
  116.     ;; never to return. (note: args 2 was setup above)
  117.     (move nil-reg A3)
  118.     (load l (d@r a1 20) extra)
  119.     (j= extra zero %debug)
  120.     (move t-reg A3)
  121. %debug
  122.     (load l (d@r P (static *boot*)) P)
  123.     (load l (d@r p 2) p)
  124.     (load l (d@r P -2) extra)
  125.     (add ($ 2) extra)
  126.     (jr extra)
  127.     (move  ($ 4) NARGS)))                            
  128.  
  129.  
  130. ;;;; Low-level exception handling
  131. #|
  132. (lap-template (0 0 -1 t stack %fault-frame-handler)
  133. %fault-frame-template
  134.     (bisb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  135.     (ashl ($ -8) (d@r SP 4) S0)                    ; fault header
  136.     (addl2 ($ 2) S0)                          ; 2 for header and template
  137.     (tstl (d@r SP 12))
  138.     (j= foobar)
  139.     (movl (d@r SP 12) (index (@r SP) S0))   ; restore hacked top of stack
  140. foobar
  141.     (addl2 ($ 16) sp)        ; pop template,header,pointers on stack,hack top
  142.     (movl (d@r SP (* (+ *pointer-temps* *scratch-temps* 10) 4))
  143.              A1)                           ; context
  144.     (movl (@r+ SP) (d@r A1 %%df_pc))
  145.     (movl (@r+ SP) (d@r A1 %%df_r4))    ; P
  146.     (movl (@r+ SP) (d@r A1 %%df_r5))    ; A1
  147.     (movl (@r+ SP) (d@r A1 %%df_r6))    ; A2
  148.     (movl (@r+ SP) (d@r A1 %%df_r7))    ; A3
  149.     (movl (@r+ SP) (d@r A1 %%df_r8))    ; A4
  150.     (movl (@r+ SP) (d@r A1 %%df_r9))    ; AN
  151.     (movl (@r+ SP) (d@r A1 %%df_r10))    ; TP
  152.  
  153.     (movl ($ -2) S0)
  154. %fault-restore-loop                                  ; restore temps
  155.     (movl (@r+ SP) (index (@r TASK) S0))
  156.     (incl S0)
  157.     (cmpl ($ (fx/ temp-block-size 4)) S0)          
  158.     (j> %fault-restore-loop)
  159.     (addl2 ($ 4) SP)                           ; pop context
  160.     (bicb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  161.     (rsb)
  162. %fault-frame-handler
  163.     (movl nil-reg an)
  164.     (rsb))
  165.  
  166. (lap-template (0 0 -1 nil stack handle-foreign-return)
  167. %foreign-return
  168.     (bisb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  169.     (addl2 ($ 8) sp)                         ; pop template,header
  170.     (movl (@r+ SP) (d@r TASK task/foreign-call-cont))
  171.     (bicb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  172.     (rsb)
  173. handle-foreign-return
  174.     (movl nil-reg AN)
  175.     (rsb))
  176.                  
  177.  
  178. (lap-template (0 0 -1 nil stack handle-enable-return)
  179. %re-enabled
  180.     (addl2 ($ 4) sp)                         ; pop return address
  181.     (rsb)
  182. handle-enable-return
  183.     (movl nil-reg AN)
  184.     (rsb))
  185.  
  186. (lap-template (0 0 -1 nil stack handle-doing-gc-return)
  187. %doing-gc-return
  188.     (addl2 ($ 4) sp)                         ; pop return address
  189.     (rsb)
  190. handle-doing-gc-return
  191.     (movl nil-reg AN)
  192.     (rsb))
  193.  
  194. ;;; Interrupts can be deferred.   
  195. ;;; the task/critical count byte has
  196. ;;; bit 7 -- interrupts deferred
  197. ;;; bit 6 -- interrupts ignored
  198. ;;; bit 1 -- quit pending
  199. ;;; bit 0 -- timer interrupt pending
  200. |#        
  201. (define (interrupt_dispatcher)       ; arg pointer is AN
  202.   (lap (signal-handler enable-signals gc_interrupt)
  203.  
  204.       (move ($ -1) extra)
  205.       (jr extra)
  206.       (noop)))
  207. #|
  208.     (equate %%fault-sp-offset 8)
  209.     (equate %%df_r4       -36)                    ; P
  210.     (equate %%df_r5       -32)                    : a1
  211.     (equate %%df_r6       -112)                   ; a2
  212.     (equate %%df_r7       -108)                   ; a3
  213.     (equate %%df_r8       -104)                   ; a4
  214.     (equate %%df_r9       -100)                   ; an
  215.     (equate %%df_r10       -96)                   ; tp
  216.     (equate %%df_pc       12)
  217.     (equate fault-quit      3)
  218.     (equate fault-interrupt                   2)
  219.     (equate fault-virtual-timer               26)
  220.                                              
  221.     (movl (d@r AN 4) A4)                       ; get signal code
  222.     (movl (d@r nil-reg slink/current-task) task)    ; restore task
  223.     (bbs ($ 6) (d@r task (fx+ task/critical-count 3)) (to %ignore-interrupt))
  224.     (movl (d@r AN 12) AN)                      ; get context
  225.     (cmpl ($ fault-virtual-timer) A4)             ; is this a timer interrupt?
  226.     (j= %timer)                                   
  227.     (cmpl ($ fault-interrupt) A4)                   ; is this a ^q?
  228.     (jn= %fault)                                  ; if so ..
  229.     (cmpl (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  230.     (jn= %doing-gc)                               ; if not ...
  231.     (tstl (d@r TASK task/foreign-call-cont))
  232.     (jn= %fault)
  233.     (bitb ($ 2) (d@r TASK (fx+ task/critical-count 3)))   ; is this the second one?                
  234.     (j= %set-interrupt-flag)                      ; if not, defer interrupt
  235.     (bicb2 ($ 2) (d@r TASK (fx+ task/critical-count 3)))
  236.     (tstb (d@r TASK (fx+ task/critical-count 3)))       ; are interrupts deferred?
  237.     (j= %fault)                                   ; if so ...
  238. %set-interrupt-flag    
  239.     (bisb2 ($ 2) (d@r TASK (fx+ task/critical-count 3)))  ; set quit bit 
  240.     (jmp (label %ignore-interrupt))
  241. %timer
  242.     (cmpl (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  243.     (jn= %ignore-interrupt)
  244.     (tstb (d@r TASK (fx+ task/critical-count 3)))
  245.     (j= %fault) 
  246.     (bisb2 ($ 1) (d@r TASK (fx+ task/critical-count 3)))  ; set timer bit 
  247. %ignore-interrupt 
  248.     (pushal (label %re-enabled))                     ; re-enable interrupts
  249.     (movl (d@r p (static 'enable-signals)) p)    ; DON'T CONS!!!
  250.     (movl (d@r p 2) p)
  251.     (movl (d@r p -2) tp)
  252.     (jmp (@r tp))                                                       
  253.  
  254. %doing-gc
  255.     (pushal (label %doing-gc-return))
  256.     (movl (d@r p (static 'gc_interrupt)) p)
  257.     (movl (d@r p 2) p)
  258.     (movl (d@r p -2) tp)
  259.     (jmp (@r tp))                                                       
  260.  
  261.  
  262. ;;; Interrupts should be disabled here.
  263. %fault
  264.     (movl (d@r task task/foreign-call-cont) S1)
  265.     (j=  %t-code-interrupt)
  266.  
  267.     ;; Interrupted out of foreign code.
  268.     (clrl (d@r task task/foreign-call-cont))     
  269.     (pushl s1)                       ; push foreign continuation
  270.     (subl2 sp s1)                   ; compute frame size
  271.     (ashl ($ 6) S1 S1)
  272.     (movb ($ (fx+ header/fault-frame 128)) S1)
  273.     (pushl s1)                      ; push frame size 
  274.     (pushal (label %foreign-return))
  275.     (jmp (label %fault-done))
  276.                                  
  277. ;;; registers s0=fault-sp  aN=context                                   
  278. %t-code-interrupt                    
  279.     (pushl AN)                  ; save context
  280.     (movl (d@r AN %%fault-sp-offset) S0)        ; get fault SP in S0
  281.     (movl S0 A1)                        ; save fault sp
  282.  
  283.     (movl ($ (fx/ (fx+ temp-block-size 4) 4)) S2)
  284. %fault-save-loop                              ; save temps and extra p and s
  285.     (pushl (index (d@r TASK -8) S2))
  286.     (decl S2)
  287.     (j>= %fault-save-loop)
  288.                                                                          
  289.     (pushl (d@r AN %%df_r10)) ; TP
  290.     (pushl (d@r AN %%df_r9)) ; AN
  291.     (pushl (d@r AN %%df_r8)) ; A4
  292.     (pushl (d@r AN %%df_r7)) ; A3
  293.     (pushl (d@r AN %%df_r9)) ; A2
  294.     (pushl (d@r AN %%df_r5)) ; A1
  295.     (pushl (d@r AN %%df_r4)) ; P
  296.     (movl (d@r AN %%df_pc) S1)
  297.     (pushl S1) 
  298.     (cmpl (d@r nil-reg slink/kernel-begin) S1)
  299.     (j> %not-in-kernel)
  300.     (cmpl (d@r nil-reg slink/kernel-end) S1)
  301.     (j< %not-in-kernel)
  302.     (pushl (@r A1))              ; save hack top of stack
  303.     (pushl ($ 0))                      ; no pointers on top
  304.     (jmp (label %t-code-done))
  305.  
  306. %not-in-kernel
  307.     (pushl ($ 0))                      ; no hacked stack top
  308.  
  309. ;;; find how many pointers on top of stack
  310.     (mnegl ($ 1) s1)                    ; pointer slot counter as fixnum
  311.  
  312. %find-last-template-loop
  313.     (incl s1)                      ; incr # pointer counter
  314.     (movl (@r+ a1) s2)                  ; load next word
  315.     (cmpb ($ header/vframe) s2)          ; vframe?
  316.     (j= %found-frame)                         ; .. if so, done looking
  317.  
  318.     (bicb3 ($ #b11111100) s2 s3)                        ; copy for extend test
  319.     (cmpb ($ tag/extend) s3)             ; extend?
  320.     (jn=  %find-last-template-loop)        ; .. if not, keep looking
  321.     (cmpb ($ header/template) (d@r s2 -2))               ; fetch template 
  322.     (jn= %find-last-template-loop)        ; .. if high bit is 0, keep looking
  323.  
  324. %found-frame
  325.     (ashl ($ 2) s1 (@-r SP))                  ; push number of pointers on stack
  326. %t-code-done
  327.     (subl2 sp s0)                         ; compute total size of frame
  328.     (ashl ($ 6) s0 s0)
  329.     (movb ($ header/fault-frame) s0)
  330.     (pushl s0)                  ; push fault header
  331.     (pushal (label %fault-frame-template))         ; call fault handler
  332.  
  333. %fault-done                                            
  334.     (ashl ($ 2) A4 a1)                        ; 1st argument is signal code
  335.     (moval (d@r SP 6) a2)                         ; 2nd argument is frame
  336.     (movl (d@r p (static 'signal-handler)) p)   ; ...
  337.     (movl (d@r p 2) p)
  338.     (movl (d@r p -2) tp)                     ; ...
  339.     (jmp (@r tp))                               ; ...
  340.  
  341.     ))                           
  342. |#
  343. (define local-processor
  344.   (lambda ()
  345.     (object nil
  346.       ((processor-type self)     'mips)
  347.       ((print-type-string self)  "Processor"))))
  348.  
  349. (define (local-machine)
  350.   (object nil                               
  351.       ((machine-type self)          'mipsco)
  352.       ((page-size self)             512)
  353.       ((machine-suspend-file self) '(link mipssuspend))
  354.       ((object-file-type self)      'mpo)
  355.       ((information-file-type self) 'mpi)
  356.       ((noise-file-type self)       'mpn)
  357.       ((print-type-string self)     "Machine")))
  358.  
  359. (define (nan? x) (ignore x) '#f)
  360.  
  361. (define (st_mtime stat-block)
  362.   (+ (ash (mref-16-u stat-block 34) 16) 
  363.      (mref-16-u stat-block 32)))
  364.  
  365. (define-integrable (st_size stat-block)
  366.   (mref-integer stat-block 20))
  367.  
  368.  
  369. (define-integrable (st_mode stat-block)
  370.   (mref-16-u stat-block 8))
  371.  
  372. (define-constant %%apollo-d-ieee-size 53)
  373. (define-constant %%apollo-d-ieee-excess 1023)
  374.  
  375. ;;; <n,s> means bit field of length s beginning at bit n of the first
  376. ;;; WORD (not longword)
  377. ;;;                    sign      exponent   MSB       fraction
  378. ;;; IEEE flonum        <15,1>    <4,11>     hidden    <0,4>+next 3 words
  379. ;;; VAX11 flonum (D)   <15,1>    <7,8>      hidden    <0,7>+next 3 words
  380.  
  381. (define (integer-decode-float x)     ; IEEE version
  382.   (let ((a (mref-16-u x 0)))
  383.     (return (if (fl<= 0.0 x) 1 -1)
  384.             (+ (mref-16-u x 6)
  385.                (%ash (+ (mref-16-u x 4)
  386.                         (%ash (fx+ (mref-16-u x 2)
  387.                                    (fixnum-ashl (fx+ (fixnum-bit-field a 0 4) 16)
  388.                                                 16))
  389.                               16))
  390.                      16))
  391.             (fx- (fixnum-bit-field a 4 11) (fx+ 1024 51)))))
  392.  
  393. (define (integer-encode-float sign m e)
  394.   (let ((float (make-flonum)))
  395.     (receive (sign mantissa exponent)
  396.              (normalize-float-parts sign
  397.                                     m
  398.                                     e
  399.                                     %%apollo-d-ieee-size 
  400.                                     %%apollo-d-ieee-excess 
  401.                                     t)
  402.       (set (mref-16-u float 0) (fx+ (fixnum-ashl sign 15)
  403.                                     (fx+ (fixnum-ashl exponent 4)
  404.                                          (bignum-bit-field mantissa 48 4))))
  405.       (set (mref-16-u float 2) (bignum-bit-field mantissa 32 16)) 
  406.       (set (mref-16-u float 4) (bignum-bit-field mantissa 16 16)) 
  407.       (set (mref-16-u float 6) (bignum-bit-field mantissa 0  16)) 
  408.       float)))
  409.